home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
scope
/
026-050
/
scopedisk29
/
sysreq
/
sysreqst.bas
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1995-03-18
|
5KB
|
186 lines
REM * This program has a good routine for requestors in AmigaBASIC
REM * so I included the basic code in the arc. Feel free to use this
REM * requestor listing in your programs. The button gadgets do return
REM * a value of 1 or 2, for button 1 or button 2, to the main
REM * program so they may be put to practical use.
REM * Enjoy........Michael Fahrion
REM * To run in AmigaBASIC you must have an output window. The small
REM * window created here is lost in the upper left of the workbench.
REM * There is no way to prevent basic from opening a full size window
REM * when it is loaded. I have deleteed the WINDOW line in the compiled
REM * version so there is no window except the requestors. If you are
REM * using this requestor coding in your program just delete it.
WINDOW 1,"",(0,0)-(5,5),0
REM * These globle arrays and variables should be initialized at
REM * at the beginning of your program.
DEFINT a-z
DIM work%(400)
DIM x1(20),y1(20),x2(20),y2(20)
ScrId=-1:which=0:BoxIndex=1:maxlen=15
RANDOMIZE TIMER
REM * This is the main loop. It sets up a random length pause of 5 to 10
REM * seconds and randomly picks a requestor to display.
REM * Note the use of TIMER and a WHILE:WEND loop. This method of pausing
REM * will always give you a specifed pause in seconds no matter if the
REM * program is compiled, run with an excellerator board or not.
WhichOne:
nsec=INT(RND*5)+5
pause&=TIMER:WHILE pause&+nsec>TIMER:WEND
wr=INT(RND*12)+1
IF onebfor = wr OR twobefor = wr THEN WhichOne REM * Check for repeats
twobefor=1befor:onebefor = wr
ON wr GOSUB 10,20,30,40,50,60,70,80,90,100,110,120
GOTO WhichOne
REM * CALL calls the subroutine "ReQuest" and passes the variables to it.
REM * Usage ("Message1","Message2","Button1","Button2",Variable returned)
10 :
CALL ReQuest("Insert Volumn XXI","in drive DF23: ","CANCEL","RESUME",which)
RETURN
20 :
CALL ReQuest("Is it OK to explode","your Amiga now? ","YES","NO",which)
RETURN
30 :
CALL ReQuest("Not that disk dummy","I want the blue one","CANCEL","RESUME",which)
RETURN
40 :
CALL ReQuest("Pick either button"," I won't do it anyway","CANCEL","RESUME",which)
RETURN
50 :
CALL ReQuest("Why did you do that","???????????","CANCEL","BECAUSE",which)
RETURN
60 :
CALL ReQuest("ROM is corrupted","Sorry about that","TRY","CRY",which)
RETURN
70 :
CALL ReQuest("Not a DO$ disk ","Use expesive type","CANCLE","RESUME",which)
RETURN
80 :
CALL ReQuest(" Disk write-protected"," Close little window ","OPEN","CLOSE",which)
RETURN
90 :
CALL ReQuest("Disk is full "," ","BURP","BELCH",which)
RETURN
100 :
CALL ReQuest("Object in use ","You can't have it","NO-NO","NO-NO",which)
RETURN
110 :
CALL ReQuest("Object not found","Try the tan disk","MAYBE","BLUE?",which)
RETURN
120 :
CALL ReQuest("The only workbench","still with EDIT! ","DELETE","DELETE",which)
RETURN
WINDOW CLOSE 1
CLEAR REM * Clears the memory of variables
SYSTEM REM * returns memory to system
END
REM *** This is the requestor sub program ***
SUB ReQuest(msg1$,msg2$,b1$,b2$,which) STATIC
SHARED BoxIndex,ScrId
SHARED x1(),y1(),x2(),y2()
BoxIndex=1:height=PEEKW(WINDOW(8)+58)
winwidth=20*(8-2*(height=9))+35
WINDOW 2,"System Request",(0,0)-(winwidth,50),7,ScrId
LINE(0,0)-(winwidth,50),1,bf:COLOR 0,1
PRINT :PRINT TAB(11-LEN(msg1$)/2);msg1$
PRINT TAB(11-LEN(msg2$)/2);msg2$:PRINT
LOCATE ,2:TxBox b1$
PRINT TAB(20-LEN(b2$));:TxBox b2$:which=0
CALL WaitBox(which)
CALL FlashRelease(which)
WINDOW CLOSE 2
END SUB
REM * Another sub program to make gadget buttons to fit text
SUB TxBox(msg$) STATIC
SHARED x1(),y1(),x2(),y2()
SHARED BoxIndex
x1=WINDOW(4):y1=WINDOW(5)-10
PRINT " ";msg$;" ";
x2=WINDOW(4):y2=y1+14
CALL box(BoxIndex,x1,y1,x2,y2)
BoxIndex=BoxIndex+1
PRINT SPC(1);
END SUB
REM * Draws boxes around gadgets
SUB box(i,x1,y1,x2,y2) STATIC
SHARED x1(),y1(),x2(),y2()
IF x2<x1 THEN SWAP x1,x2
LINE (x1,y1)-(x2,y2),1-(WINDOW(6)>1),b
LINE (x1-2,y1-2)-(x2+2,y2+2),3,b
x1(i)=x1:y1(i)=y1:x2(i)=x2:y2(i)=y2
END SUB
REM * Wait routine till a button is clicked
SUB WaitBox(which) STATIC
which=0
WHILE which=0
CALL WhichBox(which)
WEND
EXIT SUB
RETURN
END SUB
REM * Flashes the selected gadget
SUB FlashRelease(which) STATIC
SHARED x1(),y1(),x2(),y2(),work%()
SHARED RelVerify
GET (x1(which),y1(which))-(x2(which),y2(which)),work%
PUT (x1(which),y1(which)),work%,PRESET
ix=MOUSE(1):iy=MOUSE(2):RelVerify=-1
WHILE MOUSE(0)<>0
IF MOUSE(1)<>ix OR MOUSE(2)<>iy THEN RelVerify=0
WEND
PUT (x1(which),y1(which)),work%,PSET
END SUB
REM * Sets value of variable for which button clicked
SUB WhichBox(which) STATIC
SHARED x1(),y1(),x2(),y2(),BoxIndex
IF MOUSE(0)=0 THEN EXIT SUB
x=MOUSE(1):y=MOUSE(2):i=1
WHILE i < BoxIndex AND NOT (x>x1(i) AND x<x2(i) AND y>y1(i) AND y<y2(i))
i=i+1
WEND
which=i:IF i=BoxIndex THEN which=0
END SUB